W <- df3_women$treat_num[index]
Z <- df3_women$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot3 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="steelblue") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "Would reccommend a friend to date",
x = "",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())+
geom_vline(xintercept = -.1, linetype="longdash", colour="red2")
index <- with(df3_women, complete.cases(outcome2, treat_num))
X <- df3_women[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_women$outcome2[index]
W <- df3_women$treat_num[index]
Z <- df3_women$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot4 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="#B12A90FF") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "I would date",
x = "Effects among women",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(face="bold"))+
geom_vline(xintercept = -.14, linetype="longdash", colour="red2")
(grf_plot1+grf_plot3)/(grf_plot2+grf_plot4)+
plot_annotation(caption = 'Red reference line indicates primary effect among full sample',
title = 'Study 3 - Sensitivity test: Causal random forest') &
theme(plot.title = element_text(face="bold"))
ggsave("FigureC5.png",
path = here("figures/appendix"),dpi=800)
View(df3_het)
###CRF###
df3_men<- df3_men  %>%
mutate(treat_num=as.numeric(profileBI),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonswhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
###CRF###
df3_men<- df3_men  %>%
mutate(treat_num=as.numeric(profileBI),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
df3_women<- df3_women  %>%
mutate(treat_num=as.numeric(profileBI),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
covs <- c("age", "degreenum", "rightnum", "attentionnum", "nonwhitenum")
index <- with(df3_men, complete.cases(outcome1, treat_num))
X <- df3_men[index, c(covs)]
###CRF###
df3_men<- df3_men  %>%
mutate(treat_num=as.numeric(profileBI),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
df3_women<- df3_women  %>%
mutate(treat_num=as.numeric(profileBI),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
covs <- c("age", "degreenum", "rightnum", "attentionnum", "nonwhitenum")
index <- with(df3_men, complete.cases(outcome1, treat_num))
X <- df3_men[index, c(covs)]
###CRF###
df3_men<- df3_men  %>%
mutate(treat_num=as.numeric(profileBI),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionnum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
df3_women<- df3_women  %>%
mutate(treat_num=as.numeric(profileBI),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionnum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
covs <- c("age", "degreenum", "rightnum", "attentionnum", "nonwhitenum")
index <- with(df3_men, complete.cases(outcome1, treat_num))
X <- df3_men[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_men$outcome1[index]
W <- df3_men$treat_num[index]
Z <- df3_men$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot1 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="steelblue") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "Would reccommend a friend to date",
x = "",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
index <- with(df3_men, complete.cases(outcome2, treat_num))
X <- df3_men[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_men$outcome2[index]
W <- df3_men$treat_num[index]
Z <- df3_men$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot2 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="#B12A90FF") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "I would date",
x = "Effects among men",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(face="bold"))
index <- with(df3_women, complete.cases(outcome1, treat_num))
X <- df3_women[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_women$outcome1[index]
W <- df3_women$treat_num[index]
Z <- df3_women$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot3 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="steelblue") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "Would reccommend a friend to date",
x = "",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
index <- with(df3_women, complete.cases(outcome2, treat_num))
X <- df3_women[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_women$outcome2[index]
W <- df3_women$treat_num[index]
Z <- df3_women$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot4 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="#B12A90FF") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "I would date",
x = "Effects among women",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(face="bold"))
(grf_plot1+grf_plot3)/(grf_plot2+grf_plot4)+
plot_annotation(caption = 'Red reference line indicates primary effect among full sample',
title = 'Study 3 - Causal random forest') &
theme(plot.title = element_text(face="bold"))
ggsave("FigureC5.png",
path = here("figures/appendix"),dpi=800)
table(df3_men$treat_num)
table(df3_men$profileBI)
View(grf_df)
m1< lm(profile_woulddate ~ profileBI, df3_men)
m1<- lm(profile_woulddate ~ profileBI, df3_men)
m1
m1<- lm(profile_woulddate ~ treat_profile, df3_men)
m1
df3_men<- df3_men  %>%
mutate(treat_num=as.numeric(treat_profile),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionnum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
m1<- lm(profile_woulddate ~ treat_profile, df3_men)
m1
###CRF###
df3_men<- df3_men  %>%
mutate(treat_num=as.numeric(treat_profile),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionnum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
df3_women<- df3_women  %>%
mutate(treat_num=as.numeric(treat_profile),
age=as.numeric(age),
degreenum=as.numeric(degree),
rightnum=as.numeric(rightwing),
attentionnum=as.numeric(attentionpass),
nonwhitenum=as.numeric(nonwhite),
outcome1=as.numeric(profile_recommend),
outcome2=as.numeric(profile_woulddate))
covs <- c("age", "degreenum", "rightnum", "attentionnum", "nonwhitenum")
index <- with(df3_men, complete.cases(outcome1, treat_num))
X <- df3_men[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_men$outcome1[index]
W <- df3_men$treat_num[index]
Z <- df3_men$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot1 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="steelblue") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "Would reccommend a friend to date",
x = "",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
index <- with(df3_men, complete.cases(outcome2, treat_num))
X <- df3_men[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_men$outcome2[index]
W <- df3_men$treat_num[index]
Z <- df3_men$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot2 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="#B12A90FF") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "I would date",
x = "Effects among men",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(face="bold"))
index <- with(df3_women, complete.cases(outcome1, treat_num))
X <- df3_women[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_women$outcome1[index]
W <- df3_women$treat_num[index]
Z <- df3_women$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot3 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="steelblue") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "Would reccommend a friend to date",
x = "",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
index <- with(df3_women, complete.cases(outcome2, treat_num))
X <- df3_women[index, c(covs)]
X <- as.matrix(X)
Y_Obs <- df3_women$outcome2[index]
W <- df3_women$treat_num[index]
Z <- df3_women$treat_num[index]
set.seed(123)
tau_forest <- instrumental_forest(Y = Y_Obs, X = X, W = W, Z = Z,
honesty = TRUE, num.trees = 4000, seed = 123)
tau_hat_forest <- predict(tau_forest, estimate.variance = TRUE)
sigma_hat <- sqrt(tau_hat_forest$variance.estimates)
grf_df <-
cbind(data.frame(
tau_hat = tau_hat_forest$predictions,
ci_upper = tau_hat_forest$predictions + 1.96 * sigma_hat,
ci_lower = tau_hat_forest$predictions - 1.96 * sigma_hat),
X
)
grf_df$order <- with(grf_df, rank(tau_hat, ties.method = "first"))
grf_plot4 <-
grf_df %>%
ggplot(., aes(x = tau_hat, y = order)) +
geom_vline(xintercept = 0, linetype="longdash", colour="black")+
scale_color_manual(values = colors, guide = "none")+
geom_errorbarh(aes(xmin = ci_lower, xmax = ci_upper),
alpha = 0.15, height = 0, size = 0.5, color="#B12A90FF") +
geom_point(size = 1, pch = 20, color="navyblue") +
labs(subtitle = "I would date",
x = "Effects among women",
y = "")+
theme_ggdist()+
xlim(-.4,.3)+
theme(strip.background = element_blank(),
strip.text = element_text(color="black", size=10, face="bold", hjust=.5),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.title.x = element_text(face="bold"))
(grf_plot1+grf_plot3)/(grf_plot2+grf_plot4)+
plot_annotation(caption = 'Red reference line indicates primary effect among full sample',
title = 'Study 3 - Causal random forest') &
theme(plot.title = element_text(face="bold"))
ggsave("FigureC5.png",
path = here("figures/appendix"),dpi=800)
#---- Primary replication script ----
# Stuart J. Turnbull-Dugarte (2025)
# "Liberal in the sheets [...]"
# Accepted at European Journal of Political Research
# README: This single script will reproduce all analysis and output from the main text and supplementary appendix file,
# and produces three .html files of the log output from each.
remove(list=ls())
library(knitr)
library(sessioninfo)
rmarkdown::render("script1_studyI.R")
rmarkdown::render("script2_studyII.R")
rmarkdown::render("script3_studyIII.R")
rmarkdown::render("script4_misc.R")
writeLines(c(
"---- Session Info: Turnbull-Dugarte (2025) ----",
capture.output(sessioninfo::session_info())
), "session_log.txt")
